home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / savescrn.swg / 0013_Super Screen Save.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-25  |  7KB  |  251 lines
  1. {
  2. :   Is there a way to save the current text screen so you can call it
  3. : up later? (ie: Either save the screen so you can display something else
  4. : in text, then bring back the first page, or to display graphics, then
  5. : bring back the old text screen.)  Also, is there a way to dumb the screen
  6. : to disk?
  7.  
  8. Here's the stuff i use... (It works from TP 4.0 and up)
  9. }
  10.  
  11. Type
  12.     ScreenRecord =
  13.       Record
  14.         X, Y: Byte; {x,y coord. of cursor}
  15.         Screen: Pointer
  16.       End;
  17.  
  18.   Var
  19.     OriginalScreen: ScreenRecord;
  20.  
  21.  
  22. Function QueryAdapterType: AdapterType;
  23.  
  24.   Var
  25.     Code: Byte;
  26.     Regs: Registers;
  27.  
  28.   Begin
  29.     Regs.AH := $1A; { Attempt to call VGA Identify Adapter Function }
  30.     Regs.AL := $00; { Must clear AL to 0 ... }
  31.     Intr($10, Regs);
  32.     If Regs.AL = $1A then { ...so that If $1A comes back in AL... }
  33.       Begin { ...we know a PS/2 video BIOS is out there. }
  34.       Case Regs.BL of { Code comes back in BL }
  35.         $00:
  36.           QueryAdapterType := None;
  37.         $01:
  38.           QueryAdapterType := MDA;
  39.         $02:
  40.           QueryAdapterType := CGA;
  41.         $04:
  42.           QueryAdapterType := EGAColor;
  43.         $05:
  44.           QueryAdapterType := EGAMono;
  45.         $07:
  46.           QueryAdapterType := VGAMono;
  47.         $08:
  48.           QueryAdapterType := VGAColor;
  49.         $0A, $0C:
  50.           QueryAdapterType := MCGAColor;
  51.         $0B:
  52.           QueryAdapterType := MCGAMono
  53.         else
  54.           QueryAdapterType := CGA
  55.         End { Case }
  56.       End
  57.     else
  58.     { Next we have to check for the presence of an EGA BIOS: }
  59.       Begin
  60.       Regs.AH := $12; { Select Alternate Function service }
  61.       Regs.BX := $10; { BL=$10 means return EGA information }
  62.       Intr($10, Regs); { Call BIOS VIDEO }
  63.       If Regs.BX <> $10 then { BX unchanged means EGA is NOT there...}
  64.         Begin
  65.         Regs.AH := $12; { Once we know Alt Function exists... }
  66.         Regs.BL := $10; { ...we call it again to see If it's... }
  67.         Intr($10, Regs); { ...EGA color or EGA monochrome. }
  68.         If Regs.BH = 0 then
  69.           QueryAdapterType := EGAColor
  70.         else
  71.           QueryAdapterType := EGAMono
  72.         End
  73.       else { Now we know we have an EGA or MDA: }
  74.         Begin
  75.         Intr($11, Regs); { Equipment determination service }
  76.         Code := (Regs.AL and $30) Shr 4;
  77.         Case Code of
  78.           1:
  79.             QueryAdapterType := CGA;
  80.           2:
  81.             QueryAdapterType := CGA;
  82.           3:
  83.             QueryAdapterType := MDA
  84.           else
  85.             QueryAdapterType := CGA
  86.           End { Case }
  87.         End
  88.       End
  89.   End;
  90.  
  91.  
  92. Function DeterminePoints: Integer;
  93.  
  94.   Var
  95.     Regs: Registers;
  96.  
  97.   Begin
  98.     Case QueryAdapterType of
  99.       CGA:
  100.         DeterminePoints := 8;
  101.       MDA:
  102.         DeterminePoints := 14;
  103.       EGAMono, { These adapters may be using any of }
  104.       EGAColor, { several different font cell heights, }
  105.       VGAMono, { so we need to query the BIOS to find }
  106.       VGAColor, { out which is currently in use. }
  107.       MCGAMono, MCGAColor:
  108.         Begin
  109.         With Regs do
  110.           Begin
  111.           AH := $11; { EGA/VGA Information Call }
  112.           AL := $30;
  113.           BL := 0
  114.           End;
  115.  
  116.         Intr($10, Regs);
  117.         DeterminePoints := Regs.CX
  118.         End
  119.       End { Case }
  120.   End;
  121.  
  122.  
  123. Procedure SaveScreen(Var StashPtr: Pointer);
  124.  
  125.   Type
  126.     VidPtr = ^VidSaver;
  127.     VidSaver =
  128.       Record
  129.         Base, Size: Word;
  130.         BufStart: Byte
  131.       End;
  132.  
  133.   Var
  134.     VidVector: VidPtr;
  135.     StashBuf: VidSaver;
  136.     VidBuffer: Pointer;
  137.     Adapter: AdapterType;
  138.  
  139.   Begin
  140.     Adapter := QueryAdapterType;
  141.     With StashBuf do
  142.       Begin
  143.       Case Adapter of
  144.         MDA, EGAMono, VGAMono, MCGAMono:
  145.           Base := $B000
  146.         else
  147.           Base := $B800
  148.         End; { Case }
  149.       Case DeterminePoints of
  150.         8:
  151.           Case Adapter of
  152.             CGA:
  153.               Size := 4000; { 25-line screen }
  154.             EGAMono, EGAColor:
  155.               Size := 6880 { 43-line screen }
  156.             else
  157.               Size := 8000 { 50-line screen }
  158.             End; { Case }
  159.         14:
  160.           Case Adapter of
  161.             EGAMono, EGAColor:
  162.               Size := 4000; { 25-line screen }
  163.             else
  164.               Size := 4320 { 27-line screen }
  165.             End; { Case }
  166.         16:
  167.           Size := 4000
  168.         End; { Case }
  169.       VidBuffer := Ptr(Base, 0)
  170.       End;
  171.  
  172.     { Allocate heap for whole shebang }
  173.     GetMem(StashPtr, StashBuf.Size + 16);
  174.     { Here we move *ONLY* the VidSaver Record (5 bytes) to the heap: }
  175.     Move(StashBuf, StashPtr^, Sizeof(StashBuf));
  176.     { This casts StashPtr, a generic pointer, to a pointer to a VidSaver: }
  177.     VidVector := StashPtr;
  178.       { Now we move the video buffer itself to the heap.  The vide data is
  179.         written starting at the BufStart byte in the VidSaver Record, and
  180.         goes on for Size bytes to fit the whole buffer.  Messy but hey,
  181.         this is PC land! }
  182.     Move(VidBuffer^, VidVector^.BufStart, StashBuf.Size);
  183.   End;
  184.  
  185.  
  186. Procedure RestoreScreen(StashPtr: Pointer);
  187.  
  188.   Type
  189.     VidPtr = ^VidSaver;
  190.     VidSaver =
  191.       Record
  192.         Base, Size: Word;
  193.         BufStart: Byte
  194.       End;
  195.  
  196.   Var
  197.     DataSize: Word;
  198.     VidVector: VidPtr;
  199.     VidBuffer: Pointer;
  200.  
  201.   Begin
  202.     VidVector := StashPtr; { Cast generic pointer onto VidSaver pointer }
  203.     DataSize := VidVector^.Size;
  204.     { Create a pointer to the base of the video buffer: }
  205.     VidBuffer := Ptr(VidVector^.Base, 0);
  206.     { Move the buffer portion of the data on the heap to the video buffer: }
  207.     Move(VidVector^.BufStart, VidBuffer^, VidVector^.Size);
  208.     FreeMem(StashPtr, DataSize + 16)
  209.   End;
  210. (*
  211.  
  212. Here's how you save a screen...
  213.  
  214.       With OriginalScreen do
  215.         Begin
  216.         X := WhereX; {save the x,y cursor positions...}
  217.         Y := WhereY - 1;
  218.         SaveScreen(Screen) {then the screen}
  219.         End;
  220.  
  221. Here's how you restore a screen...
  222.  
  223.     With OriginalScreen do
  224.       Begin
  225.       RestoreScreen(Screen); {restore the screen}
  226.       GotoXY(X, Y) {go back to the orig. cursor position}
  227.       End;
  228.  
  229. :   While we're at it, I might as well get all my questions out of my
  230. : system :)  First, is there a way to stop the program from crashing if
  231. : someone enters a character instead of an integer (or any incompatible
  232. : data types?)  I've been looking around but havn't found anything...
  233.  
  234. The best way is to read the number in as a string (characters), then use
  235. the procedure Val(), to convert it from a character string to numeric.
  236.  
  237. : And lastly, how do you stop the program from crashing if a user enters
  238. : a filename to load, and it doesn't exist?  I think this has something
  239. : to do with the doserror (is that the function name?  Don't recall offhand)
  240. : but I couldn't get it to work.
  241.  
  242. Check to see if the file exists, before you open it (Reset)...  Here's a
  243. quick function..
  244.  
  245. Function Exists(FileName: String): Boolean;
  246.  
  247.   Begin
  248.     Exists := FSearch(FileName, '') <> ''
  249.   End;
  250. *)
  251.